Option Explicit

Private Declare PtrSafe Function ShellExecute _
  Lib "shell32.dll" Alias "ShellExecuteA" ( _
  ByVal hWnd As Long, _
  ByVal Operation As String, _
  ByVal Filename As String, _
  Optional ByVal Parameters As String, _
  Optional ByVal Directory As String, _
  Optional ByVal WindowStyle As Long = vbMinimizedFocus _
  ) As Long

Private p&, token, dic
Const nCellMax = 500
Function ManualStartGateway()
    If StartGateway Then MsgBox ("Success!")
End Function
Function StartGateway() As Boolean
    Dim lRunning As Boolean
    Dim objWMIService As Object, colItems As Object, objItem As Object
    Dim cPath As String
    Dim strComputer As String
    Dim cCmd As String
    Dim cSite As String
    Dim wsh As Object
    Dim waitOnReturn As Boolean: waitOnReturn = False
    Dim WindowStyle As Integer: WindowStyle = 4
    Dim lSuccess As Long
    Dim cString As String
    
    lRunning = False
    StartGateway = False

    strComputer = "."
    
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_Process", , 48)
    For Each objItem In colItems
        If objItem.Caption = "cmd.exe" Then
            'Gateway appears to be running already
            lRunning = True
        End If
    Next
    
    Set objWMIService = Nothing
    
    If Not lRunning Then
        cPath = ThisWorkbook.Sheets("Settings").Range("B2").Value
        
        If CheckFileExists(cPath + "\bin\run.bat") Then
            
            'Start the Gateway Javascript code
            Set wsh = VBA.CreateObject("WScript.Shell")
             
            cCmd = "cmd /K cd /d " + cPath + " && bin\run.bat root\conf.yaml"
            
            wsh.Run cCmd, WindowStyle, waitOnReturn
        
            'Wait to make sure all processing is complete
            Application.Wait Now + #12:00:05 AM#
            
            'Start the login web page
            cSite = ThisWorkbook.Sheets("Settings").Range("B3").Value
            
            ActiveWorkbook.FollowHyperlink _
            Address:=cSite, _
            NewWindow:=True, _
            AddHistory:=True
    
            Application.Wait Now + #12:00:15 AM#
            
            StartGateway = True
        Else
            MsgBox "Trying to start the IBKR Gateway application but it is not in the path specified on the Settings tab. " & _
                "Please download and install the Client Portal API from https://www.interactivebrokers.com/en/trading/ib-api.php"
            StartGateway = False
        End If
        
    Else
        StartGateway = True
    
    End If
    

End Function
Function GetAccountID() As String
    GetAccountID = ThisWorkbook.Sheets("Settings").Range("B4").Value
    If Len(GetAccountID) < 2 Then
        MsgBox "Invalid Account ID! Please enter your Account ID on the Settings tab."
    End If
End Function
Function CheckFileExists(cFile) As Boolean

Dim strFileName As String
Dim strFileExists As String

    strFileName = cFile
    strFileExists = Dir(strFileName)

   If strFileExists = "" Then
        CheckFileExists = False
    Else
        CheckFileExists = True
    End If

End Function



Function GetAccounts()
Dim cString As String

    cString = APICall("https://localhost:5000/v1/api/iserver/accounts", "GET")
    'MsgBox cString
    
    
End Function

Function APICall(cEndPoint As String, cType As String, Optional lReAuth As Boolean) As String
Dim oHttp As Object
Dim httpGet As String
Dim cURL_EndPoint As String

    If lReAuth Then
        ReAuth
    End If

    cURL_EndPoint = cEndPoint
    Set oHttp = New Msxml2.XMLHTTP60
    Call oHttp.Open(cType, cURL_EndPoint, False)
    oHttp.setRequestHeader "Content-Type", "application/json"
   
    Call oHttp.Send
    
    httpGet = oHttp.responseText
    
    APICall = httpGet
    
    Set oHttp = Nothing

End Function

Function Validate() As Boolean
Dim cString As String

    cString = APICall("https://localhost:5000/v1/api/sso/validate", "POST")
    
    Validate = False
    
    If InStr(cString, Chr(34) + "RESULT" + Chr(34) + ":true") > 0 Then
        Validate = True
    End If

End Function
Function Tickle() As Boolean
Dim oHttp As Object
Dim httpGet As String
Dim cURL_EndPoint As String
Dim cPostData As String

    Tickle = False
    
    cURL_EndPoint = "https://localhost:5000/v1/api/tickle"
        
    
    Set oHttp = New Msxml2.XMLHTTP60
    Call oHttp.Open("POST", cURL_EndPoint, False)
    oHttp.setRequestHeader "Content-Type", "application/json"
    
    Call oHttp.Send
    
    httpGet = oHttp.responseText
    
    
    If InStr(httpGet, Chr(34) + "connected" + Chr(34) + ":true") > 0 Then
        Tickle = True
    End If
    
    Set oHttp = Nothing
    

End Function
Function ReAuth() As Boolean
Dim oHttp As Object
Dim httpGet As String
Dim cURL_EndPoint As String
Dim cPostData As String

    ReAuth = False
    
    If StartGateway Then
     
        cURL_EndPoint = "https://localhost:5000/v1/api/iserver/reauthenticate"
        
        Set oHttp = New Msxml2.XMLHTTP60
        Call oHttp.Open("POST", cURL_EndPoint, False)
        oHttp.setRequestHeader "Content-Type", "application/json"
        
        Call oHttp.Send
         
        httpGet = oHttp.responseText
         
        If InStr(httpGet, Chr(34) + "triggered") > 0 Then
            ReAuth = True
        End If
         
        Set oHttp = Nothing
    Else
        MsgBox "The Client Portal API Gateway could not be started. Process failed."
    End If

End Function
Function AuthStatus() As Boolean
Dim oHttp As Object
Dim httpGet As String
Dim cURL_EndPoint As String
Dim cPostData As String

    AuthStatus = False
    
    cURL_EndPoint = "https://localhost:5000/v1/api/iserver/auth/status"
        
    
    Set oHttp = New Msxml2.XMLHTTP60
    Call oHttp.Open("POST", cURL_EndPoint, False)
    oHttp.setRequestHeader "Content-Type", "application/json"
   
    Call oHttp.Send
    
    httpGet = oHttp.responseText
    
    
    If InStr(httpGet, Chr(34) + "authenticated" + Chr(34) + ":true") > 0 Then
        AuthStatus = True
    End If
    
    Set oHttp = Nothing
    
End Function



Function ParseJSON(JSON$, Optional key$ = "obj") As Object

On Error GoTo ErrOut

    p = 1
    token = Tokenize(JSON)
    Set dic = CreateObject("Scripting.Dictionary")
    If token(p) = "{" Then ParseObj key Else ParseArr key
    

    Set ParseJSON = dic
    
    Exit Function
    
ErrOut:
    MsgBox "API connection error. Please restart the API."
    
End Function
Function ParseObj(key$)


    Do: p = p + 1
    
        Select Case token(p)
            Case "]"
            Case "[":  ParseArr key
            Case "{":  ParseObj key
            Case "{"
                       If token(p + 1) = "}" Then
                           p = p + 1
                           dic.Add key, "null"
                       Else
                           ParseObj key
                       End If
                
            Case "}":  key = ReducePath(key): Exit Do
            Case ":":  key = key & "." & token(p - 1)
            Case ",":  key = ReducePath(key)
            Case Else:
                If token(p + 1) <> ":" Then
                    If dic.exists(key) Then
                        dic.Item(key) = token(p)
                    Else
                        dic.Add key, token(p)
                    End If
                End If
        End Select
    Loop
    
    
End Function
Function ParseArr(key$)

    Dim e&
    Do: p = p + 1
        Select Case token(p)
            Case "}"
            Case "{":  ParseObj key & ArrayID(e)
            Case "[":  ParseArr key
            Case "]":  Exit Do
            Case ":":  key = key & ArrayID(e)
            Case ",":  e = e + 1
            Case Else:
                If Not dic.exists(key & ArrayID(e)) Then
                    dic.Add key & ArrayID(e), token(p)
                End If
        End Select
    Loop
    
End Function
Function Tokenize(s$)
    Const Pattern = """(([^""\\]|\\.)*)""|[+\-]?(?:0|[1-9]\d*)(?:\.\d*)?(?:[eE][+\-]?\d+)?|\w+|[^\s""']+?"
    Tokenize = RExtract(s, Pattern, True)
End Function
Function RExtract(s$, Pattern, Optional bGroup1Bias As Boolean, Optional bGlobal As Boolean = True)
  Dim c&, m, n, v
  With CreateObject("vbscript.regexp")
    .Global = bGlobal
    .MultiLine = False
    .IgnoreCase = True
    .Pattern = Pattern
    If .Test(s) Then
      Set m = .Execute(s)
      ReDim v(1 To m.Count)
      For Each n In m
        c = c + 1
        v(c) = n.Value
        If bGroup1Bias Then If Len(n.SubMatches(0)) Or n.Value = """""" Then v(c) = n.SubMatches(0)
      Next
    End If
  End With
  RExtract = v
End Function
Function ArrayID$(e)
    ArrayID = "(" & e & ")"
End Function
Function ReducePath$(key$)
    If InStr(key, ".") Then ReducePath = Left(key, InStrRev(key, ".") - 1) Else ReducePath = key
End Function
Function GetFilteredValues(dic, match)
    Dim c&, i&, v, w
    v = dic.keys
    ReDim w(1 To dic.Count)
    For i = 0 To UBound(v)
        If v(i) Like match Then
            c = c + 1
            w(c) = dic(v(i))
        End If
    Next
    ReDim Preserve w(1 To c)
    GetFilteredValues = w
End Function
Function GetFilteredTable(dic, cols)
    Dim c&, i&, j&, v, w, z
    v = dic.keys
    z = GetFilteredValues(dic, cols(0))
    ReDim w(1 To UBound(z), 1 To UBound(cols) + 1)
    For j = 1 To UBound(cols) + 1
         z = GetFilteredValues(dic, cols(j - 1))
         For i = 1 To UBound(z)
            w(i, j) = z(i)
         Next
    Next
    GetFilteredTable = w
End Function
Function OpenTextFile$(f)
    With CreateObject("ADODB.Stream")
        .Charset = "utf-8"
        .Open
        .LoadFromFile f
        OpenTextFile = .ReadText
    End With
End Function
Sub Auto_Open()

    If MsgBox("This spreadsheet is to be used for demonstration purposes only. Use at your own risk. Wattcollc and affiliates are not liable for any consequential damages you may incur. Please use this demo at your own risk. Continue?", vbYesNo) = vbNo Then
        ActiveWorkbook.Close
    End If

End Sub

Sub mcrBuySell()
Dim x As Integer
Dim cStock As String
Dim nQty As Integer
Dim nLimit As Double
Dim nStopLoss As Double
Dim nPrice As Double
Dim nSell As Double
Dim cMsg As String
Dim cDuration As String
Dim lProceed As Boolean


    'B=Price
    'C=Qty Buy/Sell
    'D=Limit
    'E=Sell
    'F=Stop Loss
    'G=DURATION
    'H=Order Value
    'I=Notes
    
    'Get latest prices
    
    If BlankStockRows Then Exit Sub
    
    mcrGetQuotes
    
   
    For x = 5 To nCellMax
        nLimit = 0
        nStopLoss = 0
        nSell = 0
        cStock = ThisWorkbook.Sheets("Stocks").Range("A" + Trim(Str(x))).Value
        
        If Len(cStock) = 0 Then x = nCellMax
        
        ColorCells False, x
        ColorQuoteCells False, x
        
        If Len(cStock) > 0 And Len(cStock) < 7 And _
            IsNumeric(ThisWorkbook.Sheets("Stocks").Range("C" + Trim(Str(x))).Value) Then
            
            nQty = ThisWorkbook.Sheets("Stocks").Range("C" + Trim(Str(x))).Value
            
            If nQty <> 0 Then
            
                If Not IsNumeric(ThisWorkbook.Sheets("Stocks").Range("D" + Trim(Str(x))).Value) Then
                    ThisWorkbook.Sheets("Stocks").Range("D" + Trim(Str(x))).Value = 0
                End If
                nLimit = ThisWorkbook.Sheets("Stocks").Range("D" + Trim(Str(x))).Value
                cDuration = ThisWorkbook.Sheets("Stocks").Range("G" + Trim(Str(x))).Value
            
                nPrice = ThisWorkbook.Sheets("Stocks").Range("B" + Trim(Str(x))).Value
                
                If ThisWorkbook.Sheets("Stocks").Range("G" + Trim(Str(x))).Value <> "DAY" Then
                    ThisWorkbook.Sheets("Stocks").Range("G" + Trim(Str(x))).Value = "GTC"
                End If
                
                If nQty > 0 Then 'Buy Order
                    'Check Limit
                    If Not IsNumeric(ThisWorkbook.Sheets("Stocks").Range("D" + Trim(Str(x))).Value) Then
                        ThisWorkbook.Sheets("Stocks").Range("D" + Trim(Str(x))).Value = 0
                    Else
                        nLimit = ThisWorkbook.Sheets("Stocks").Range("D" + Trim(Str(x))).Value
                        If nLimit > 0 Then
                            If nLimit > nPrice Then
                                MsgBox cStock + " limit price is greater than the current price! Please correct. Nothing has been purchased."
                                Exit Sub
                            End If
                        End If
                    End If
                    
                    'Check Sell
                    If Not IsNumeric(ThisWorkbook.Sheets("Stocks").Range("E" + Trim(Str(x))).Value) Then
                        ThisWorkbook.Sheets("Stocks").Range("E" + Trim(Str(x))).Value = 0
                        nSell = 0
                    Else
                        nSell = ThisWorkbook.Sheets("Stocks").Range("E" + Trim(Str(x))).Value
                        If nSell > 0 Then
                            If nLimit > 0 Then
                                If nSell < nLimit Then
                                    MsgBox cStock + " sell price is less than the limit price! Please correct. Nothing has been purchased."
                                    Exit Sub
                                End If
                            Else
                                If nSell < nPrice Then
                                    MsgBox cStock + " sell price is less than the current price! Please correct. Nothing has been purchased."
                                    Exit Sub
                                End If
                            End If
                        End If
                    End If
                    
                    
                    'Check StopLoss
                    If Not IsNumeric(ThisWorkbook.Sheets("Stocks").Range("F" + Trim(Str(x))).Value) Then
                        ThisWorkbook.Sheets("Stocks").Range("F" + Trim(Str(x))).Value = 0
                        nStopLoss = 0
                    Else
                        nStopLoss = ThisWorkbook.Sheets("Stocks").Range("F" + Trim(Str(x))).Value
                        If nStopLoss > 0 Then
                            If nLimit > 0 Then
                                If nStopLoss > nLimit Then
                                    MsgBox cStock + " stop loss price is greater than the limit price! Please correct. Nothing has been purchased."
                                    Exit Sub
                                End If
                            End If
                            If nSell > 0 Then
                                If nStopLoss > nSell Then
                                    MsgBox cStock + " stop loss price is greater than the sell price! Please correct. Nothing has been purchased."
                                    Exit Sub
                                End If
                            End If
                            If nStopLoss > nPrice Then
                                MsgBox cStock + " stop loss price is greater than the current price! Please correct. Nothing has been purchased."
                                Exit Sub
                            End If
                        End If
                    End If
                    

                
                Else 'Sell Order
                    
                    'Check Limit
                    If Not IsNumeric(ThisWorkbook.Sheets("Stocks").Range("D" + Trim(Str(x))).Value) Then
                        ThisWorkbook.Sheets("Stocks").Range("D" + Trim(Str(x))).Value = 0
                    Else
                        nLimit = ThisWorkbook.Sheets("Stocks").Range("D" + Trim(Str(x))).Value
                        If nLimit < nPrice And nLimit <> 0 Then
                            MsgBox cStock + " limit price is less than the current price! Please correct. Nothing has been sold."
                            Exit Sub
                        End If
                    End If
                    'No Sell
                    ThisWorkbook.Sheets("Stocks").Range("E" + Trim(Str(x))).Value = 0
                    'No StopLoss
                    ThisWorkbook.Sheets("Stocks").Range("F" + Trim(Str(x))).Value = 0
                End If
            Else 'there is a stock on this line, but no buy/sell order
            

                ThisWorkbook.Sheets("Stocks").Range("D" + Trim(Str(x))).Value = 0
                ThisWorkbook.Sheets("Stocks").Range("E" + Trim(Str(x))).Value = 0
                ThisWorkbook.Sheets("Stocks").Range("F" + Trim(Str(x))).Value = 0
                ThisWorkbook.Sheets("Stocks").Range("G" + Trim(Str(x))).Value = ""
                ThisWorkbook.Sheets("Stocks").Range("I" + Trim(Str(x))).Value = ""
            
            End If
        Else 'There is no stock on the line
            ThisWorkbook.Sheets("Stocks").Range("D" + Trim(Str(x))).Value = ""
            ThisWorkbook.Sheets("Stocks").Range("E" + Trim(Str(x))).Value = ""
            ThisWorkbook.Sheets("Stocks").Range("F" + Trim(Str(x))).Value = ""
            ThisWorkbook.Sheets("Stocks").Range("G" + Trim(Str(x))).Value = ""
            ThisWorkbook.Sheets("Stocks").Range("H" + Trim(Str(x))).Value = ""
            ThisWorkbook.Sheets("Stocks").Range("I" + Trim(Str(x))).Value = ""
        
        End If
    
    Next x
    
    'Loop through column A and purchase/sell any valid stock symbols with a quantity <> 0
    For x = 5 To nCellMax
    
        
        cStock = ThisWorkbook.Sheets("Stocks").Range("A" + Trim(Str(x))).Value
        
        ColorCells True, x
        
        If Len(cStock) = 0 Then
            ColorCells False, x
            x = nCellMax
            
        End If
        
        nLimit = ThisWorkbook.Sheets("Stocks").Range("D" + Trim(Str(x))).Value
        nSell = ThisWorkbook.Sheets("Stocks").Range("E" + Trim(Str(x))).Value
        nStopLoss = ThisWorkbook.Sheets("Stocks").Range("F" + Trim(Str(x))).Value
        cDuration = ThisWorkbook.Sheets("Stocks").Range("G" + Trim(Str(x))).Value
        nPrice = ThisWorkbook.Sheets("Stocks").Range("B" + Trim(Str(x))).Value
        cMsg = ""
        
        If nLimit > 0 Then
            cMsg = " with a LIMIT price of " + Trim(Str(nLimit))
        Else
            cMsg = " at MARKET price of " + Trim(Str(nPrice))
        End If
        
        If nStopLoss > 0 Then
            cMsg = cMsg + " with a STOP LOSS of " + Trim(Str(nStopLoss))
        End If
        
        If nSell > 0 Then
            cMsg = cMsg + " with a SELL PRICE of " + Trim(Str(nSell))
        End If
        
        If cDuration = "DAY" Then
            cMsg = cMsg + " - order good for today (DAY)"
        Else
            cMsg = cMsg + " - order good until cancel (GTC)"
        End If
        
        lProceed = False
        
        If Len(cStock) > 0 And Len(cStock) < 7 And _
            IsNumeric(ThisWorkbook.Sheets("Stocks").Range("C" + Trim(Str(x))).Value) Then
            nQty = ThisWorkbook.Sheets("Stocks").Range("C" + Trim(Str(x))).Value
            
            
            If (nLimit = 0 And nStopLoss = 0 And nSell > 0) Or _
                (nLimit = 0 And nStopLoss > 0 And nSell = 0) Or _
                (nLimit = 0 And nStopLoss > 0 And nSell > 0) Then
                MsgBox "IBKR does not allow multi-part Market orders. Please change to a Limit order."
                ThisWorkbook.Sheets("Stocks").Range("I" + Trim(Str(x))).Value = "Cancelled"
            End If
            
            If nQty > 0 Then
                If MsgBox("Buy " + Trim(Str(nQty)) + " of " + cStock + cMsg, vbYesNo) = vbYes Then lProceed = True
            End If
            If nQty < 0 Then
                If MsgBox("Sell " + Trim(Str(nQty)) + " of " + cStock + cMsg, vbYesNo) = vbYes Then lProceed = True
            End If
            If lProceed Then
                PlaceOrder cStock, nQty, x, nLimit, nSell, nStopLoss, cDuration
            Else
                If nQty <> 0 Then
                    MsgBox "Order for " + cStock + " was not placed."
                    ThisWorkbook.Sheets("Stocks").Range("I" + Trim(Str(x))).Value = "Cancelled"
                End If
                
            End If
        Else
            ThisWorkbook.Sheets("Stocks").Range("I" + Trim(Str(x))).Value = ""
        End If
    Next x

End Sub
Function WriteOut(cString As String)
    Open "C:\Temp\SQLString.txt" For Output As #1    ' Open file for output.
    Print #1, cString ', 234    ' Write comma-delimited data.
    Close #1    ' Close file.
End Function
Function ColorCells(lOn As Boolean, nRow As Integer)
Dim x As Integer

    ThisWorkbook.Sheets("Stocks").Range("A" + Trim(Str(nRow))).Select
    
    If lOn Then
        With Selection.Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .Color = 5296274
          .TintAndShade = 0
          .PatternTintAndShade = 0
        End With
    Else
        With Selection.Interior
          .Pattern = xlNone
          .TintAndShade = 0
          .PatternTintAndShade = 0
        End With
    End If
    

End Function
Function ColorQuoteCells(lOn As Boolean, nRow As Integer)
Dim x As Integer

    ThisWorkbook.Sheets("Stocks").Range("B" + Trim(Str(nRow))).Select
    
    If lOn Then
        With Selection.Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .Color = 5296274
          .TintAndShade = 0
          .PatternTintAndShade = 0
        End With
    Else
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark2
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End If
    

End Function



Sub mcrGetOrders()
Dim cCustomerKey As String
Dim cAccountNumber As String
Dim cAccessToken As String
Dim x As Integer
Dim x2 As Integer
Dim x3 As Integer


Dim cPostData As String
Dim cURL_EndPoint As String


Dim cStatus As String
Dim cInstruction As String
Dim nQty As String
Dim cSymbol As String
Dim nPrice As Double
Dim cType As String
Dim nOrderID As Double
Dim cEntered As String
Dim cDuration As String
Dim cStatusDescr As String

Dim cString As String
Dim cString2 As String
Dim nDaysBack As Integer

Dim cTime As String
Dim tDic As Object

Dim oHttp As Object
Dim httpGet As String
Dim nConID As Long


    'GetAccounts
    cString = APICall("https://localhost:5000/v1/api/iserver/accounts", "GET")
    httpGet = APICall("https://localhost:5000/v1/api/iserver/account/orders", "GET")
    
    Set tDic = ParseJSON(httpGet)
    MsgBox httpGet
    'ListPaths tDic, "Orders"
    
    x2 = 5
    
    ThisWorkbook.Sheets("Order Status").Range("A5:K5000").Clear
    
    For x = 1 To nCellMax
        nOrderID = Val(tDic("obj.orders(" + Trim(Str(x - 1)) + ").orderId"))
        If nOrderID = 0 Then
            x = nCellMax
        Else
            cStatus = tDic("obj.orders(" + Trim(Str(x - 1)) + ").status")
            nQty = tDic("obj.orders(" + Trim(Str(x - 1)) + ").filledQuantity")
            nConID = tDic("obj.orders(" + Trim(Str(x - 1)) + ").conid")
            cSymbol = GetSymbol(nConID)
            cInstruction = tDic("obj.orders(" + Trim(Str(x - 1)) + ").side")
            cStatusDescr = tDic("obj.orders(" + Trim(Str(x - 1)) + ").Status")

            nPrice = tDic("obj.orders(" + Trim(Str(x - 1)) + ").avgPrice")
            cType = tDic("obj.orders(" + Trim(Str(x - 1)) + ").orderType")
            cDuration = tDic("obj.orders(" + Trim(Str(x - 1)) + ").timeInForce")
            cEntered = tDic("obj.orders(" + Trim(Str(x - 1)) + ").lastExecutionTime_r")
            cEntered = Epoch2DateS(Val(cEntered))
            
            ThisWorkbook.Sheets("Order Status").Range("A" + Trim(Str(x2))).Value = ""
            
            ThisWorkbook.Sheets("Order Status").Range("B" + Trim(Str(x2))).Value = Chr(39) + Str(nOrderID)
            ThisWorkbook.Sheets("Order Status").Range("C" + Trim(Str(x2))).Value = cStatus
            Range("C" + Trim(Str(x2))).Select

            Select Case UCase(cStatus)
            Case "REJECTED", "INACTIVE"
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
            Case "FILLED"
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 5296274
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
            Case "WORKING"
                Range("A" + Trim(Str(x2))).Select
                
                With Selection.Font
                    .Name = "Calibri"
                    .FontStyle = "Bold"
                    .Size = 11
                    .Strikethrough = False
                    .Superscript = False
                    .Subscript = False
                    .OutlineFont = False
                    .Shadow = False
                    .Underline = xlUnderlineStyleNone
                    .ThemeColor = xlThemeColorDark1
                    .TintAndShade = 0
                    .ThemeFont = xlThemeFontMinor
                End With
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                With Selection.Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                With Selection.Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                With Selection.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                With Selection.Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                Selection.Borders(xlInsideVertical).LineStyle = xlNone
                Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorLight1
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
                            
                ThisWorkbook.Sheets("Order Status").Range("A" + Trim(Str(x2))).Value = "CANCEL"
            End Select

            ThisWorkbook.Sheets("Order Status").Range("D" + Trim(Str(x2))).Value = nQty
            ThisWorkbook.Sheets("Order Status").Range("E" + Trim(Str(x2))).Value = cSymbol
            ThisWorkbook.Sheets("Order Status").Range("F" + Trim(Str(x2))).Value = nPrice
            ThisWorkbook.Sheets("Order Status").Range("G" + Trim(Str(x2))).Value = cType
            ThisWorkbook.Sheets("Order Status").Range("H" + Trim(Str(x2))).Value = cEntered
            ThisWorkbook.Sheets("Order Status").Range("I" + Trim(Str(x2))).Value = cDuration
            ThisWorkbook.Sheets("Order Status").Range("J" + Trim(Str(x2))).Value = cStatusDescr
            
            x2 = x2 + 1
            
            'Get child elements
            For x3 = 1 To 100
                nOrderID = Val(tDic("obj.orders(" + Trim(Str(x - 1)) + ").childOrderStrategies(0).childOrderStrategies(" + Trim(Str(x3 - 1)) + ").orderId"))
                If nOrderID = 0 Then
                    x3 = 100
                Else
                    cStatus = tDic("obj.orders(" + Trim(Str(x - 1)) + ").childOrderStrategies(0).childOrderStrategies(" + Trim(Str(x3 - 1)) + ").status")
                    nQty = tDic("obj.orders(" + Trim(Str(x - 1)) + ").childOrderStrategies(0).childOrderStrategies(" + Trim(Str(x3 - 1)) + ").quantity")
                    cSymbol = tDic("obj.orders(" + Trim(Str(x - 1)) + ").childOrderStrategies(0).childOrderStrategies(" + Trim(Str(x3 - 1)) + ").orderLegCollection(0).instrument.symbol")
                    cInstruction = tDic("obj.orders(" + Trim(Str(x - 1)) + ").childOrderStrategies(0).childOrderStrategies(" + Trim(Str(x3 - 1)) + ").orderLegCollection(0).instruction")
                    cStatusDescr = tDic("obj.orders(" + Trim(Str(x - 1)) + ").childOrderStrategies(0).childOrderStrategies(" + Trim(Str(x3 - 1)) + ").statusDescription")
                    nPrice = tDic("obj.orders(" + Trim(Str(x - 1)) + ").childOrderStrategies(0).childOrderStrategies(" + Trim(Str(x3 - 1)) + ").price")
                    cType = tDic("obj.orders(" + Trim(Str(x - 1)) + ").childOrderStrategies(0).childOrderStrategies(" + Trim(Str(x3 - 1)) + ").orderType")
                    cDuration = tDic("obj.orders(" + Trim(Str(x - 1)) + ").childOrderStrategies(0).childOrderStrategies(" + Trim(Str(x3 - 1)) + ").duration")
                    cEntered = tDic("obj.orders(" + Trim(Str(x - 1)) + ").childOrderStrategies(0).childOrderStrategies(" + Trim(Str(x3 - 1)) + ").enteredTime")
                    
                    
                    ThisWorkbook.Sheets("Order Status").Range("B" + Trim(Str(x2))).Value = Chr(39) + "     " + Str(nOrderID)
                    ThisWorkbook.Sheets("Order Status").Range("C" + Trim(Str(x2))).Value = cStatus
                    Range("C" + Trim(Str(x2))).Select

                    Select Case cStatus
                    Case "REJECTED"
                        With Selection.Interior
                            .Pattern = xlSolid
                            .PatternColorIndex = xlAutomatic
                            .Color = 255
                            .TintAndShade = 0
                            .PatternTintAndShade = 0
                        End With
                    Case "FILLED"
                        With Selection.Interior
                            .Pattern = xlSolid
                            .PatternColorIndex = xlAutomatic
                            .Color = 5296274
                            .TintAndShade = 0
                            .PatternTintAndShade = 0
                        End With
                    End Select
                    
                    ThisWorkbook.Sheets("Order Status").Range("D" + Trim(Str(x2))).Value = nQty
                    ThisWorkbook.Sheets("Order Status").Range("E" + Trim(Str(x2))).Value = cSymbol
                    ThisWorkbook.Sheets("Order Status").Range("F" + Trim(Str(x2))).Value = nPrice
                    ThisWorkbook.Sheets("Order Status").Range("G" + Trim(Str(x2))).Value = cType
                    ThisWorkbook.Sheets("Order Status").Range("H" + Trim(Str(x2))).Value = cEntered
                    ThisWorkbook.Sheets("Order Status").Range("I" + Trim(Str(x2))).Value = cDuration
                    ThisWorkbook.Sheets("Order Status").Range("J" + Trim(Str(x2))).Value = cStatusDescr
                    
                    
                    x2 = x2 + 1
                End If
            Next x3

            
            
            
        End If
        
    Next x
    
    ThisWorkbook.Sheets("Order Status").Range("F5:F" + Trim(Str(x2))).Select
    Selection.Style = "Currency"

    ThisWorkbook.Sheets("Order Status").Range("D2").Value = "Last updated: " + Trim(Str(Date)) + " " + Trim(Str(Time))
    
End Sub



Function Epoch2DateS(epochstamp$) As Date

    Epoch2DateS = CVDate(CDbl(DateSerial(1970, 1, 1)) + Int(Val(epochstamp$) / 1000#) / 86400)

End Function
Function CancelOrder(nOrderID As Double, nRow As Integer)
Dim cCustomerKey As String
Dim cAccountNumber As String
Dim cAccessToken As String
    
Dim oHttp As Object
Dim httpGet As String
Dim parsetext As String
Dim cURL_EndPoint As String
Dim x As Integer
Dim cPostData As String
Dim nAskPrice As Double

    
    cURL_EndPoint = "https://api.tdameritrade.com/v1/accounts/883275202/orders/" + Trim(Str(nOrderID))
        
    cPostData = "Bearer " + cAccessToken
    
    Set oHttp = New Msxml2.XMLHTTP60
    Call oHttp.Open("DELETE", cURL_EndPoint, False)
    oHttp.setRequestHeader "Authorization", cPostData
    oHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    oHttp.setRequestHeader "Host", "api.tdameritrade.com"
   
        
    Call oHttp.Send(cPostData)
    
    httpGet = oHttp.responseText
    
    Set oHttp = Nothing
    
    mcrGetOrders
    
End Function

Function GetSymbol(nContractID As Long) As String
Dim httpGet As String
Dim tDic As Object

    httpGet = APICall("https://localhost:5000/v1/api/iserver/contract/" + Trim(Str(nContractID)) + "/info", "GET")
    Set tDic = ParseJSON(httpGet)
    GetSymbol = tDic("obj.symbol")
    
    
End Function



Function mcrGetPositions()
Dim x As Integer
Dim x2 As Integer

Dim oHttp As Object
Dim httpGet As String
Dim cURL_EndPoint As String
Dim cSymbol As String
Dim nAveragePrice As Double
Dim nLongQuantity As Double
Dim nShortQuantity As Double
Dim nDayPL As Double
Dim nValue As Double
Dim nQty As Double
Dim nCost As Double
Dim cLine As String
Dim nConID As Long
Dim tDic As Object


    httpGet = APICall("https://localhost:5000/v1/api/portfolio/" + GetAccountID + "/positions/0", "GET", False)
    
    If Len(httpGet) < 10 Then
        MsgBox "No positions to report!"
        Exit Function
    End If
    
    Set tDic = ParseJSON(httpGet)
    'ListPaths tDic, "Portfolio"
 
 
    
    x2 = 5
    
    ThisWorkbook.Sheets("Portfolio").Range("A5:E500").Clear
    
    For x = 1 To nCellMax
        nConID = tDic("obj(" + Trim(Str(x - 1)) + ").conid")
        cSymbol = GetSymbol(nConID)
        If cSymbol = "" Then
            x = nCellMax
        Else
            nAveragePrice = tDic("obj(" + Trim(Str(x - 1)) + ").avgPrice")
            nDayPL = tDic("obj(" + Trim(Str(x - 1)) + ").unrealizedPnl")
            nLongQuantity = tDic("obj(" + Trim(Str(x - 1)) + ").position")
            nShortQuantity = tDic("obj(" + Trim(Str(x - 1)) + ").position")
            nQty = tDic("obj(" + Trim(Str(x - 1)) + ").position")
            nValue = tDic("obj(" + Trim(Str(x - 1)) + ").mktValue")
    
            ThisWorkbook.Sheets("Portfolio").Range("A" + Trim(Str(x2))).Value = cSymbol
            ThisWorkbook.Sheets("Portfolio").Range("B" + Trim(Str(x2))).Value = nAveragePrice
            ThisWorkbook.Sheets("Portfolio").Range("C" + Trim(Str(x2))).Value = nQty
            ThisWorkbook.Sheets("Portfolio").Range("D" + Trim(Str(x2))).Value = nValue
            ThisWorkbook.Sheets("Portfolio").Range("E" + Trim(Str(x2))).Value = nDayPL
            x2 = x2 + 1
        End If
        
    Next x
    
    If x2 >= 500 Then
        MsgBox "Error!"
        Exit Function
    End If
    
    ThisWorkbook.Sheets("Portfolio").Range("B5:B" + Trim(Str(x2))).Select
    Selection.Style = "Currency"
    ThisWorkbook.Sheets("Portfolio").Range("D5:E" + Trim(Str(x2))).Select
    Selection.Style = "Currency"
    Range("A5:E" + Trim(Str(x2))).Select
    ActiveWorkbook.Worksheets("Portfolio").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Portfolio").Sort.SortFields.Add key:=Range( _
        "A5:A" + Trim(Str(x2))), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Portfolio").Sort
        .SetRange Range("A5:E" + Trim(Str(x2)))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ThisWorkbook.Sheets("Portfolio").Range("D5:D" + Trim(Str(x2))).Select
    ThisWorkbook.Sheets("Portfolio").Range("D" + Trim(Str(x2 + 1))).Activate
    ActiveCell.FormulaR1C1 = "=SUM(R[-" + Trim(Str(x2 - 4)) + "]C:R[-1]C)"
    
    ThisWorkbook.Sheets("Portfolio").Range("E5:E" + Trim(Str(x2))).Select
    ThisWorkbook.Sheets("Portfolio").Range("E" + Trim(Str(x2 + 1))).Activate
    ActiveCell.FormulaR1C1 = "=SUM(R[-" + Trim(Str(x2 - 4)) + "]C:R[-1]C)"

    ThisWorkbook.Sheets("Portfolio").Range("D2").Value = "Last updated: " + Trim(Str(Date)) + " " + Trim(Str(Time))
    
End Function
Function BlankStockRows() As Boolean
Dim lBlankRow As Boolean
Dim nBlankRow As Integer
Dim x As Integer
Dim cStock As String


    BlankStockRows = False


    lBlankRow = False
    For x = 5 To nCellMax
        cStock = ThisWorkbook.Sheets("Stocks").Range("A" + Trim(Str(x))).Value
        If Len(cStock) > 0 And lBlankRow = True Then
            MsgBox "Remove any empty stock symbol rows before running this function. Row " + Trim(Str(nBlankRow)) + " is currently blank."
            BlankStockRows = True
            Exit Function
        End If
        If Len(cStock) = 0 Then
            lBlankRow = True
            nBlankRow = x
        End If
    Next x
    
    

End Function


Sub mcrGetQuotes()
Dim x As Integer
Dim cStock As String
Dim nQty As Integer

    
    If BlankStockRows Then Exit Sub
    
    If Not ReAuth Then Exit Sub
 
    
    ThisWorkbook.Sheets("Stocks").Range("A5:A500").Select
    With Selection.Interior
      .Pattern = xlNone
      .TintAndShade = 0
      .PatternTintAndShade = 0
    End With
  
    
    'Loop through column A and purchase any valid stock symbols with a quantity <> 0
    For x = 5 To nCellMax
        cStock = ThisWorkbook.Sheets("Stocks").Range("A" + Trim(Str(x))).Value
        If Len(cStock) > 0 And Len(cStock) < 6 Then
            GetQuote cStock, x
            ThisWorkbook.Sheets("Stocks").Range("H" + Trim(Str(x))).Formula = "=B" + Trim(Str(x)) + "*C" + Trim(Str(x))
            ThisWorkbook.Sheets("Stocks").Range("I" + Trim(Str(x))).Value = "Last quote on " + Str(Date) + " : " + Str(Time)
            
            If Not IsNumeric(ThisWorkbook.Sheets("Stocks").Range("C" + Trim(Str(x))).Value) _
                Or IsEmpty(ThisWorkbook.Sheets("Stocks").Range("C" + Trim(Str(x))).Value) Then
                ThisWorkbook.Sheets("Stocks").Range("C" + Trim(Str(x))).Value = 0
                ThisWorkbook.Sheets("Stocks").Range("D" + Trim(Str(x))).Value = 0
                ThisWorkbook.Sheets("Stocks").Range("E" + Trim(Str(x))).Value = 0
                ThisWorkbook.Sheets("Stocks").Range("F" + Trim(Str(x))).Value = 0
                ThisWorkbook.Sheets("Stocks").Range("G" + Trim(Str(x))).Value = ""
            End If
            ColorCells True, x
        End If
    Next x
    
    ThisWorkbook.Sheets("Stocks").Range("B5:B500").Select
    Selection.Style = "Currency"
    ThisWorkbook.Sheets("Stocks").Range("D5:D500").Select
    Selection.Style = "Currency"
    ThisWorkbook.Sheets("Stocks").Range("E5:E500").Select
    Selection.Style = "Currency"
    ThisWorkbook.Sheets("Stocks").Range("F5:F500").Select
    Selection.Style = "Currency"
    ThisWorkbook.Sheets("Stocks").Range("H5:H500").Select
    Selection.Style = "Currency"

End Sub

Function GetConID(cSymbol As String) As Long
Dim cString As String
Dim tDic As Object
Dim nConID As Long
Dim s$, v
Dim x As Integer

    On Error GoTo ErrOut
    
 
    GetConID = 0
    
    cString = APICall("https://localhost:5000/v1/api/trsrv/stocks?symbols=" + cSymbol, "GET", False)
    Set tDic = ParseJSON(cString)
    
    For Each v In tDic
        's = s & v & " --> " & tDic(v) & vbLf
        If InStr(v, "isUS") And tDic(v) = "true" Then
         x = Right(Left(v, Len(cSymbol) + 6), 1)
         nConID = tDic("obj." + cSymbol + "(" + Trim(Str(x)) + ").contracts(0).conid")
        End If
    Next
    
    GetConID = nConID

    
ErrOut:
    

    Exit Function
    

    
End Function

Function GetQuote(cSymbol As String, nPosition As Integer) As Double
Dim nAskPrice As Double
Dim cOS As String
Dim cString As String
Dim cAPICall As String
Dim tDic As Object

Dim oHttp As Object
Dim httpGet As String
Dim cURL_EndPoint As String
Dim cPostData As String
Dim cEndPoint As String
Dim nConID As Long

Dim s$, v
Dim x As Long
Dim nPoints As Long
    
    nConID = GetConID(cSymbol)
    
    GetAccounts
    
    If nConID = 0 Then
        MsgBox "Cannot retrieve contract ID for " + cSymbol + "!"
        Exit Function
    End If

    cEndPoint = "https://localhost:5000/v1/api/iserver/marketdata/history?conid=" + Trim(Str(nConID))
    httpGet = APICall(cEndPoint, "GET", False)
 
    Set tDic = ParseJSON(httpGet)
 
    nPoints = tDic("obj.points")

    nAskPrice = 0
    
    nAskPrice = tDic("obj.data(" + Trim(Str(nPoints)) + ").c")

    
    ThisWorkbook.Sheets("Stocks").Range("B" + Trim(Str(nPosition))).Value = nAskPrice
    
    

End Function

Function ListPaths(tDic, JSONType As String)
    Dim s$, v
    Dim x As Integer
    

    x = 1
    
    For Each v In tDic
        s = s & v & " --> " & tDic(v) & vbLf
        ThisWorkbook.Sheets("ListPaths").Range("B" + Trim(Str(x))).Value = v + "-" + tDic(v)
        x = x + 1

    Next

    
End Function


Function PlaceOrder(cSymbol As String, nQty As Integer, nPosition As Integer, nLimit As Double, nSell As Double, nStopLoss As Double, cDuration As String)

Dim cOS As String
Dim cString As String
Dim cAPICall As String

Dim oHttp As Object
Dim httpGet As String
Dim cURL_EndPoint As String
Dim cPostData As String
Dim cEndPoint As String
Dim nConID As Long
Dim cMsgID As String
Dim lFilled As Boolean
Dim tDic As Object
Dim nOID As Long
Dim cOID As String

Dim cBuyMKTString As String
Dim cSellLMTString As String
Dim cBuyLMTString As String
Dim cSellMKTString As String
Dim cSellLMTStringChildPR As String
Dim cSellLMTStringChildSL As String
Dim cOpenString As String
Dim cCloseString As String


    nConID = GetConID(cSymbol)
    If nConID = 0 Then
        Exit Function
    End If
 
    cEndPoint = "https://localhost:5000/v1/api/iserver/account/" + GetAccountID + "/orders"
    cURL_EndPoint = cEndPoint
    
    If cDuration = "GTC" Then
        'cDuration = "GOOD_TILL_CANCEL"
    End If
    If nLimit = 0 Then
        cDuration = "DAY"
    End If

    
    'Buy limit
    'Buy limit with a sell price
    'Buy limit with a stop loss
    'Buy limit with a sell price and a stop loss
    'Buy market
    'Buy market with a sell price
    'Buy market with a stop loss
    'Buy market with a sell price and a stop loss
    
    'Sell limit
    'Sell market

    nOID = Int((9999 * Rnd) + 1000)
    cOID = "Parent" + Trim(Str(nOID))
    
    cOpenString = "{" + Chr(34) + "orders" + Chr(34) + ": [" + Chr(10)
    cCloseString = "]}"
    
'    Dim cBuyLMTString As String
'    Dim cSellMKTString As String
'    Dim cOpenString As String
'    Dim cCloseString As String


    
    cBuyMKTString = "{" & _
       Chr(34) + "acctId" + Chr(34) + ": " + Chr(34) + GetAccountID + Chr(34) + "," + Chr(10) & _
       Chr(34) + "conid" + Chr(34) + ": " + Trim(Str(nConID)) + "," + Chr(10) & _
       Chr(34) + "cOID" + Chr(34) + ": " + Chr(34) + cOID + Chr(34) + "," + Chr(10) & _
       Chr(34) + "secType" + Chr(34) + ": " + Chr(34) + "STK" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "listingExchange" + Chr(34) + ": " + Chr(34) + "SMART" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "orderType" + Chr(34) + ": " + Chr(34) + "MKT" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "side" + Chr(34) + ": " + Chr(34) + "BUY" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "tif" + Chr(34) + ": " + Chr(34) + cDuration + Chr(34) + "," + Chr(10) & _
       Chr(34) + "outsideRTH" + Chr(34) + ": true," + Chr(10) & _
       Chr(34) + "isSuppressed" + Chr(34) + ": true," + Chr(10) & _
       Chr(34) + "quantity" + Chr(34) + ": " + Trim(Str(nQty)) + Chr(10) & _
       "}" + Chr(10)

    cBuyLMTString = "{" & _
       Chr(34) + "acctId" + Chr(34) + ": " + Chr(34) + GetAccountID + Chr(34) + "," + Chr(10) & _
       Chr(34) + "conid" + Chr(34) + ": " + Trim(Str(nConID)) + "," + Chr(10) & _
       Chr(34) + "cOID" + Chr(34) + ": " + Chr(34) + cOID + Chr(34) + "," + Chr(10) & _
       Chr(34) + "secType" + Chr(34) + ": " + Chr(34) + "STK" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "listingExchange" + Chr(34) + ": " + Chr(34) + "SMART" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "orderType" + Chr(34) + ": " + Chr(34) + "LMT" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "side" + Chr(34) + ": " + Chr(34) + "BUY" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "tif" + Chr(34) + ": " + Chr(34) + cDuration + Chr(34) + "," + Chr(10) & _
       Chr(34) + "outsideRTH" + Chr(34) + ": true," + Chr(10) & _
       Chr(34) + "price" + Chr(34) + ": " + Trim(Str(nLimit)) + "," + Chr(10) & _
       Chr(34) + "isSuppressed" + Chr(34) + ": true," + Chr(10) & _
       Chr(34) + "quantity" + Chr(34) + ": " + Trim(Str(nQty)) + Chr(10) & _
       "}" + Chr(10)
    
    cSellMKTString = "{" & _
       Chr(34) + "acctId" + Chr(34) + ": " + Chr(34) + GetAccountID + Chr(34) + "," + Chr(10) & _
       Chr(34) + "conid" + Chr(34) + ": " + Trim(Str(nConID)) + "," + Chr(10) & _
       Chr(34) + "secType" + Chr(34) + ": " + Chr(34) + "STK" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "listingExchange" + Chr(34) + ": " + Chr(34) + "SMART" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "orderType" + Chr(34) + ": " + Chr(34) + "MKT" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "side" + Chr(34) + ": " + Chr(34) + "SELL" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "tif" + Chr(34) + ": " + Chr(34) + cDuration + Chr(34) + "," + Chr(10) & _
       Chr(34) + "outsideRTH" + Chr(34) + ": true," + Chr(10) & _
       Chr(34) + "isSuppressed" + Chr(34) + ": true," + Chr(10) & _
       Chr(34) + "quantity" + Chr(34) + ": " + Trim(Str(nQty)) + Chr(10) & _
       "}" + Chr(10)

    cSellLMTString = "{" & _
       Chr(34) + "acctId" + Chr(34) + ": " + Chr(34) + GetAccountID + Chr(34) + "," + Chr(10) & _
       Chr(34) + "conid" + Chr(34) + ": " + Trim(Str(nConID)) + "," + Chr(10) & _
       Chr(34) + "secType" + Chr(34) + ": " + Chr(34) + "STK" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "listingExchange" + Chr(34) + ": " + Chr(34) + "SMART" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "orderType" + Chr(34) + ": " + Chr(34) + "LMT" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "side" + Chr(34) + ": " + Chr(34) + "SELL" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "tif" + Chr(34) + ": " + Chr(34) + cDuration + Chr(34) + "," + Chr(10) & _
       Chr(34) + "outsideRTH" + Chr(34) + ": true," + Chr(10) & _
       Chr(34) + "price" + Chr(34) + ": " + Trim(Str(nLimit)) + "," + Chr(10) & _
       Chr(34) + "isSuppressed" + Chr(34) + ": true," + Chr(10) & _
       Chr(34) + "quantity" + Chr(34) + ": " + Trim(Str(nQty)) + Chr(10) & _
       "}" + Chr(10)

    cSellLMTStringChildPR = "{" & _
       Chr(34) + "acctId" + Chr(34) + ": " + Chr(34) + GetAccountID + Chr(34) + "," + Chr(10) & _
       Chr(34) + "conid" + Chr(34) + ": " + Trim(Str(nConID)) + "," + Chr(10) & _
       Chr(34) + "parentId" + Chr(34) + ": " + Chr(34) + cOID + Chr(34) + "," + Chr(10) & _
       Chr(34) + "secType" + Chr(34) + ": " + Chr(34) + "STK" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "listingExchange" + Chr(34) + ": " + Chr(34) + "SMART" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "orderType" + Chr(34) + ": " + Chr(34) + "LMT" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "side" + Chr(34) + ": " + Chr(34) + "SELL" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "tif" + Chr(34) + ": " + Chr(34) + cDuration + Chr(34) + "," + Chr(10) & _
       Chr(34) + "outsideRTH" + Chr(34) + ": true," + Chr(10) & _
       Chr(34) + "price" + Chr(34) + ": " + Trim(Str(nSell)) + "," + Chr(10) & _
       Chr(34) + "isSuppressed" + Chr(34) + ": true," + Chr(10) & _
       Chr(34) + "quantity" + Chr(34) + ": " + Trim(Str(nQty)) + Chr(10) & _
       "}" + Chr(10)
 
    cSellLMTStringChildSL = "{" & _
       Chr(34) + "acctId" + Chr(34) + ": " + Chr(34) + GetAccountID + Chr(34) + "," + Chr(10) & _
       Chr(34) + "conid" + Chr(34) + ": " + Trim(Str(nConID)) + "," + Chr(10) & _
       Chr(34) + "parentId" + Chr(34) + ": " + Chr(34) + cOID + Chr(34) + "," + Chr(10) & _
       Chr(34) + "secType" + Chr(34) + ": " + Chr(34) + "STK" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "listingExchange" + Chr(34) + ": " + Chr(34) + "SMART" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "orderType" + Chr(34) + ": " + Chr(34) + "LMT" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "side" + Chr(34) + ": " + Chr(34) + "SELL" + Chr(34) + "," + Chr(10) & _
       Chr(34) + "tif" + Chr(34) + ": " + Chr(34) + cDuration + Chr(34) + "," + Chr(10) & _
       Chr(34) + "outsideRTH" + Chr(34) + ": true," + Chr(10) & _
       Chr(34) + "price" + Chr(34) + ": " + Trim(Str(nStopLoss)) + "," + Chr(10) & _
       Chr(34) + "isSuppressed" + Chr(34) + ": true," + Chr(10) & _
       Chr(34) + "quantity" + Chr(34) + ": " + Trim(Str(nQty)) + Chr(10) & _
       "}" + Chr(10)

'       Chr(34) + "isSuppressed" + Chr(34) + ": true," + Chr(10) & _

    
    If nQty > 0 Then
        'BUY
        If nLimit > 0 And nStopLoss = 0 And nSell = 0 Then 'Buy limit
            cString = cOpenString + cBuyLMTString + cCloseString
        End If
        If nLimit > 0 And nStopLoss > 0 And nSell > 0 Then 'Buy limit with a sell price and a stop loss
            cString = cOpenString + cBuyLMTString + "," + cSellLMTStringChildPR + "," + cSellLMTStringChildSL + cCloseString
        End If
        If nLimit > 0 And nStopLoss = 0 And nSell > 0 Then 'Buy limit with a sell price
            cString = cOpenString + cBuyLMTString + "," + cSellLMTStringChildPR + cCloseString
        End If
        If nLimit > 0 And nStopLoss > 0 And nSell = 0 Then 'Buy limit with a stop loss
            cString = cOpenString + cBuyLMTString + "," + cSellLMTStringChildSL + cCloseString
        End If
        If nLimit = 0 And nStopLoss = 0 And nSell = 0 Then 'Market Buy
            cString = cOpenString + cBuyMKTString + cCloseString
        End If
        If nLimit = 0 And nStopLoss = 0 And nSell > 0 Then 'Buy market with a sell price
            cString = cOpenString + cBuyMKTString + "," + cSellLMTStringChildPR + cCloseString
        End If
        If nLimit = 0 And nStopLoss > 0 And nSell = 0 Then 'Buy market with a stop loss
            cString = cOpenString + cBuyMKTString + "," + cSellLMTStringChildSL + cCloseString
        End If
        If nLimit = 0 And nStopLoss > 0 And nSell > 0 Then 'Buy market with a sell price and a stop loss
            cString = cOpenString + cBuyMKTString + "," + cSellLMTStringChildPR + "," + cSellLMTStringChildSL + cCloseString
        End If
    '----------------------------------------------------------------
    Else
        'SELL
        If nLimit > 0 Then 'Limit sell
            cString = cOpenString + cSellLMTString + cCloseString
        End If
        
        If nLimit = 0 Then 'Market Sell
           cString = cOpenString + cSellMKTString + cCloseString
        End If
    
    End If
    
    WriteOut cString
    
    'Set oHttp = New MSXML2.XMLHTTP60
    Set oHttp = New Msxml2.ServerXMLHTTP60
    Call oHttp.Open("POST", cURL_EndPoint, False)
    oHttp.setOption(2) = 13056
    oHttp.setRequestHeader "Content-Type", "application/json"
    oHttp.setRequestHeader "User-Agent", "Console"
       
    Call oHttp.Send(cString)
    
    httpGet = oHttp.responseText
    Set oHttp = Nothing
    
    If InStr(httpGet, "Outside Regular Trading Hours") > 0 Then
        MsgBox "IBKR does not allow API Market orders outside of trading hours."
        ThisWorkbook.Sheets("Stocks").Range("I" + Trim(Str(nPosition))).Value = "Cancelled"
        'ThisWorkbook.Sheets("Stocks").Range("C" + Trim(Str(nPosition))).Value = 0
        ColorQuoteCells True, nPosition
        Exit Function
    End If

    
    Set tDic = ParseJSON(httpGet)
    cMsgID = tDic("obj(0).id")
    lFilled = False

    If Len(cMsgID) > 10 Then
    
        'Suppress warning message
        cURL_EndPoint = "https://localhost:5000/v1/api/iserver/reply/" + cMsgID
        Set oHttp = New Msxml2.ServerXMLHTTP60
        Call oHttp.Open("POST", cURL_EndPoint, False)
        oHttp.setOption(2) = 13056
        oHttp.setRequestHeader "Content-Type", "application/json"
        oHttp.setRequestHeader "User-Agent", "Console"
        cString = "{" + Chr(34) + "confirmed" + Chr(34) + ": true}"
        
        Call oHttp.Send(cString)
        
        httpGet = oHttp.responseText
        Set oHttp = Nothing
        
        Set tDic = ParseJSON(httpGet)
        cMsgID = tDic("obj(0).id")
        
        If Len(cMsgID) > 0 Then 'Suppress second warning messages
            cURL_EndPoint = "https://localhost:5000/v1/api/iserver/reply/" + cMsgID
            Set oHttp = New Msxml2.ServerXMLHTTP60
            Call oHttp.Open("POST", cURL_EndPoint, False)
            oHttp.setOption(2) = 13056
            oHttp.setRequestHeader "Content-Type", "application/json"
            oHttp.setRequestHeader "User-Agent", "Console"
            cString = "{" + Chr(34) + "confirmed" + Chr(34) + ": true}"
            
            Call oHttp.Send(cString)
            
            httpGet = oHttp.responseText
            Set oHttp = Nothing
            
            Set tDic = ParseJSON(httpGet)
            cMsgID = tDic("obj(0).id")
        
        End If
        
        If InStr(httpGet, "Filled") > 0 Or InStr(httpGet, "Submitted") > 0 Then
            lFilled = True
        End If
        
    End If
    
    If lFilled Then
        ThisWorkbook.Sheets("Stocks").Range("I" + Trim(Str(nPosition))).Value = "Executed"
        ThisWorkbook.Sheets("Stocks").Range("C" + Trim(Str(nPosition))).Value = 0
        ColorQuoteCells True, nPosition
    Else
        ThisWorkbook.Sheets("Stocks").Range("I" + Trim(Str(nPosition))).Value = httpGet
    End If
    
End Function